home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / mac / hypercrd / xcmd / dxcmds34.sit / Dartmouth XCMD's 3.4.3 / card_18689.txt < prev    next >
Text File  |  1990-04-17  |  4KB  |  181 lines
  1. -- card: 18689 from stack: in.3
  2. -- bmap block id: 0
  3. -- flags: 4000
  4. -- background id: 3241
  5. -- name: SystemFolder
  6. ----- HyperTalk script -----
  7. on Install
  8.   get ChooseTargetStack()
  9.   InstallResource XFCN,SystemFolder,it
  10. end Install
  11.  
  12.  
  13. -- part 1 (button)
  14. -- low flags: 00
  15. -- high flags: A003
  16. -- rect: left=80 top=300 right=322 bottom=180
  17. -- title width / last selected line: 0
  18. -- icon id / first selected line: 0 / 0
  19. -- text alignment: 1
  20. -- font id: 0
  21. -- text size: 12
  22. -- style flags: 0
  23. -- line height: 16
  24. -- part name: SystemFolder
  25. ----- HyperTalk script -----
  26. on mouseUp
  27.   answer SystemFolder()
  28. end mouseUp
  29.  
  30.  
  31.  
  32. -- part 2 (field)
  33. -- low flags: 81
  34. -- high flags: 2007
  35. -- rect: left=12 top=26 right=298 bottom=491
  36. -- title width / last selected line: 0
  37. -- icon id / first selected line: 0 / 0
  38. -- text alignment: 0
  39. -- font id: 22
  40. -- text size: 10
  41. -- style flags: 0
  42. -- line height: 13
  43. -- part name: Source
  44.  
  45.  
  46. -- part 3 (button)
  47. -- low flags: 00
  48. -- high flags: A003
  49. -- rect: left=299 top=300 right=322 bottom=438
  50. -- title width / last selected line: 0
  51. -- icon id / first selected line: 0 / 0
  52. -- text alignment: 1
  53. -- font id: 0
  54. -- text size: 12
  55. -- style flags: 0
  56. -- line height: 16
  57. -- part name: Show Pascal Source
  58. ----- HyperTalk script -----
  59. on mouseUp
  60.   set the visible of card field 1 to not the visible of card field 1
  61.   if the visible of card field 1 is true then
  62.     set the name of me to "Hide Pascal Source"
  63.   else set the name of me to "Show Pascal Source"
  64. end mouseUp
  65.  
  66.  
  67.  
  68. -- part contents for background part 16
  69. ----- text -----
  70. SYSTEMFOLDER XFCN version 1.0.1
  71. Kevin Calhoun
  72.  
  73. SystemFolder returns the pathname of the folder that contains the currently active System file, appended by a colon.  It's intended for developers of stacks that will reside on read-only media, such as CD-ROM, who need a place to store configuration information and user preferences.  The standard place to store such information is in a file in the system folder.
  74.  
  75. EXAMPLE
  76. If you wanted to open a file called "SuperStack Prefs" in the system folder, you could use the following HyperTalk code:
  77.  
  78.    put SystemFolder() & "SuperStack Prefs" into myFile
  79.    open file myFile
  80.  
  81. 22 July 1989 -- Declares the directory ID as a longint in the parameter list of DirIDToPath.
  82.  
  83. -- part contents for card part 2
  84. ----- text -----
  85. UNIT SistimFolder;
  86.  
  87. { SystemFolder XFCN ┬⌐1989 by the Trustees of Dartmouth College }
  88. { Written by Kevin Calhoun }
  89.  
  90. { This source compatible with MPW Pascal 3.0 }
  91.  
  92. (*
  93. pascal SystemFolder.p
  94. Link -m ENTRYPOINT Γêé
  95.      -o "YourFile" Γêé
  96.      -rt XFCN=971 Γêé
  97.      -sn Main=SystemFolder Γêé
  98.      SystemFolder.p.o Γêé
  99.     "{Libraries}"interface.o Γêé
  100.     "{PLibraries}"PasLib.o Γêé
  101.     "{Libraries}"HyperXLib.o
  102. *)
  103.  
  104. {$R-}
  105.  
  106. INTERFACE
  107.   USES
  108.     Types,
  109.     Memory,
  110.     Files,
  111.     Packages,
  112.     HyperXCmd;
  113.  
  114.   PROCEDURE EntryPoint (paramPtr : XCMDPtr);
  115.  
  116. IMPLEMENTATION
  117.  
  118.   PROCEDURE SystemFolder (paramPtr : XCMDPtr); FORWARD;
  119.  
  120.   PROCEDURE EntryPoint (paramPtr : XCMDPtr);
  121.   BEGIN
  122.     SystemFolder(paramPtr);
  123.   END;
  124.   
  125.   PROCEDURE DirIDToPath(paramPtr: XCMDPtr; dirID: LONGINT; 
  126.                       vRefNum: INTEGER; VAR path: Str255);
  127.   VAR result:  INTEGER;
  128.       str:  Str255;
  129.       pb:   CInfoPBRec;
  130.   BEGIN
  131.     path := '';
  132.     ZeroBytes(paramPtr,@pb,SizeOf(pb));
  133.     pb.ioDirID := dirID;
  134.     WHILE pb.ioDirID <> 1 DO 
  135.       BEGIN
  136.       pb.ioNamePtr := @str;
  137.       pb.ioFDirIndex := -1;
  138.       pb.ioVRefNum := vRefNum;
  139.       IF PBGetCatInfo(@pb,FALSE) <> noErr THEN Exit(DirIDToPath);
  140.       path := Concat(str,':',path);
  141.       pb.ioDirID := pb.ioDrParID;
  142.       END;
  143.   END;
  144.   
  145.   FUNCTION SysRefNum: INTEGER;
  146.     CONST
  147.       SysMap=$A58; { reference number of sysResFile [word] I-114 }
  148.     TYPE
  149.       WordPtr = ^INTEGER;
  150.     VAR
  151.       w: WordPtr;
  152.   BEGIN
  153.     w := WordPtr(SysMap);
  154.     SysRefNum := w^;
  155.   END;
  156.  
  157.   PROCEDURE SystemFolder(paramPtr: XCMDPtr);
  158.     VAR
  159.       err: OSErr;
  160.       myFCBPBRec: FCBPBRec;
  161.       s: Str255;
  162.   BEGIN
  163.     ZeroBytes(paramPtr, @myFCBPBRec, SIZEOF(FCBPBRec));
  164.     with myFCBPBRec DO
  165.       BEGIN
  166.       ioCompletion := NIL;
  167.       ioNamePtr := NIL;
  168.       ioRefNum := SysRefNum;
  169.       ioFCBIndx := 0;
  170.       END;
  171.     err := PBGetFCBInfo(@myFCBPBRec, FALSE);
  172.     IF err = noErr THEN DirIDToPath(paramPtr, myFCBPBRec.ioFCBParID, myFCBPBRec.ioFCBVRefNum, s);
  173.     IF err <> noErr THEN
  174.       BEGIN
  175.       NumToStr(paramPtr, err, s);
  176.       s := CONCAT('Error ', s);
  177.       END;
  178.     paramPtr^.returnValue := PasToZero(paramPtr, s);
  179.   END;
  180.  
  181. END.